CU Amiga Super CD-ROM 14/CU Amiga Magazine's Super CD-ROM 14 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-09].iso/CUCD/Programming/SecalDemo/Projects/Examples/MandelDemo.scl

Text File | 1997-06-11 | 4.4 KB | 195 lines

/******************************************************************************\
**  Mandelbrot demo for Secal                                                 **
**  Requires Kickstart 2                                                      **
\******************************************************************************/


go main;


#-------------------------------------------------------------------------------


include "inc/libcalls/exec.inc";
include "inc/libcalls/intuition.inc";
include "inc/utility/tagitem.inc";
include "inc/graphics/gfx.inc";
include "inc/graphics/rastport.inc";
include "inc/intuition/screens.inc";


def SysBase=[4.w].ul;


/******************************************************************************\
************                      M A I N                           ************
\******************************************************************************/


obj IntuitionBase:ulong;

obj myscr,myscrbmp:ulong;
obj basex,basey:word;


#-------------------------------------------------------------------------------


main:
call sysinit;
if d0 then
    call mandel;
    while [$dff016] and $400 do;        # DIRTY CHECK FOR RIGHT MOUSE BUTTON
    call sysdone;
;

d0.l:=0;
rts;                                                            # MAIN


#-------------------------------------------------------------------------------


#                                                                    D0=SUCCESS

sysinit:
OpenLibrary("intuition.library",37); IntuitionBase:=d0;
if IntuitionBase then
    OpenScreenTagList(0,@scrtags); myscr:=d0;
    if myscr then

        a0:=myscr; myscrbmp:=Screen(a0).RastPort.BitMap;
        basex:=Screen(a0).Width/2-188/2;
        d0:=Screen(a0).Height-(Screen(a0).BarHeight+1);
        d0:=d0/2+(Screen(a0).BarHeight+1); basey:=d0-188/2;        # 0,0 OFFSET

        d0:=-1; go end_sysinit;        # INIT SUCCESSFULL
    ;

                                                        # OTHERWISE FAILED
    CloseLibrary(IntuitionBase);
;

d0:=0;

end_sysinit:
rts;                                                            # SYSINIT



scrtags:
dc.l SA_Depth,5;
dc.l SA_Title,"Secal Mandelbrot demo";
dc.l SA_Colors,@scrcolors;
dc.l SA_Pens,@scrpens;
dc.l TAG_DONE;                            # TAGS FOR OUR SCREEN

scrcolors:
dc 0,0,0,0,     1,3,3,3,     2,5,5,5,     3,0,0,0;
dc 4,0,0,0,     5,2,0,0,     6,3,0,0,     7,4,0,0;
dc 8,5,0,0,     9,6,0,0,     10,7,0,0,    11,8,0,0;
dc 12,9,0,0,    13,$a,0,0,   14,$b,0,0,   15,$c,0,0;
dc 16,$d,0,0,   17,$e,0,0,   18,$f,0,0,   19,$f,1,1;
dc 20,$f,2,2,   21,$f,3,3,   22,$f,4,4,   23,$f,5,5;
dc 24,$f,6,6,   25,$f,7,7,   26,$f,8,8,   27,$f,9,9;
dc 28,$f,$a,$a, 29,$f,$b,$b, 30,$f,$c,$c, 31,$f,$d,$d;
dc -1;                                            # COLORS OF THE SCREEN

scrpens:
dc -1;                                            # TO MAKE IT "NEW LOOK"





sysdone:
CloseScreen(myscr);                            # CLOSE SCREEN
CloseLibrary(IntuitionBase);                # CLOSE INTUITION
rts;                                                            # SYSDONE


/******************************************************************************\
************                M A N D E L B R O T                     ************
\******************************************************************************/


mandel:
push d2\d3\d4\d5;

d3:=$fc00;
for d5:=187 downto 0 do
    d2:=$fc00;
    for d4:=0 upto 187 do

        d0:=d2; d1:=d3; call iter;                # ITERATION
        a0:=4+d0; d0:=basex+d4; d1:=basey+d5; call plot;    # PLOT

        d2:=d2+1+$800/188;
    ;                                                            # X LOOP
    d3:=d3+1+$800/188;
;                                                                # Y LOOP

pop d2\d3\d4\d5;
rts;                                                            # MANDEL





obj mi_count:word;


# D0=X, D1=Y                                            D0=RESULT

iter:
push d2\d3\d4\d5;

d4:=d0; d5:=d1;

mi_count:=-1;
repeat
    d2.l:=(d4*d4) asr 9; d3.l:=(d5*d5) asr 9;        # X2:=X*X, Y2:=Y*Y
    d5.l:=(d4*d5) asr 8 and -2; d5:=d5+d1;        # Y:=2*X*Y+Y0
    d4:=d0+d2-d3;                                    # X:=X2-Y2+X0

    mi_count:=mi_count+1;
until mi_count=28 orif d2+d3>=$800;
if mi_count=28 then mi_count:=0;;

d0:=mi_count;                                        # RESULT=ITERATIONS

pop d2\d3\d4\d5;
rts;                                                            # ITER





# D0=X, D1=Y, A0.W=COLOR

plot:
push d2;
d2:=a0;

a0:=myscrbmp; d1.l:=d1.w*BitMap(a0).BytesPerRow;
d1.l:=d1+d0.w>>3; d0:=7-d0 and 7;            # OFFSET AND BIT NUMBER

a0:=@BitMap(a0).Planes[0];
a1:=[a0+]+d1;
if d2 and 1 then [a1].b:=[a1] bset d0; else [a1].b:=[a1] bclr d0;;
a1:=[a0+]+d1;
if d2 and 2 then [a1].b:=[a1] bset d0; else [a1].b:=[a1] bclr d0;;
a1:=[a0+]+d1;
if d2 and 4 then [a1].b:=[a1] bset d0; else [a1].b:=[a1] bclr d0;;
a1:=[a0+]+d1;
if d2 and 8 then [a1].b:=[a1] bset d0; else [a1].b:=[a1] bclr d0;;
a1:=[a0+]+d1;
if d2 and 16 then [a1].b:=[a1] bset d0; else [a1].b:=[a1] bclr d0;;
                                                                # PROCESS EACH PLANE
pop d2;
rts;                                                            # PLOT


#*******************************************************************************